home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / yourt.arc / YA1LOOK.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-08-28  |  4.0 KB  |  157 lines
  1. 10  GOTO 60
  2. 20  ' YA1LOOK.BAS   YOURART1 PICTURE DISPLAY PROGRAM
  3. 30  ' JULY 1984     EVERETT DELANO
  4. 40  '               P.O. BOX 205
  5. 50  '               ELK CITY, OKLA. 73648
  6. 60  DEF SEG=0:IF (PEEK(&H410) AND &H30) <> &H30 THEN 70 ELSE 1360
  7. 70  DEF SEG:POKE 106,0
  8. 80  SCREEN 0,1,0,0:WIDTH 80:KEY OFF
  9. 90  DEFINT A-Z:DIM SORT$(101)
  10. 100  ON ERROR GOTO 1170
  11. 110  GOSUB 1390
  12. 120  FOR COUNT=1 TO 10:KEY COUNT,"":NEXT
  13. 130  COLOR 7,4,1:CLS
  14. 140  LEGEND$="* Press   Esc   To EXIT *"
  15. 150  LOCATE 25,28:COLOR 2:PRINT LEGEND$;:COLOR 7
  16. 160  TITLE$="* * * * YOURART  MEDIUM  RESOLUTION  DISPLAY * * * *"
  17. 170  CENTER=(80-LEN(TITLE$))/2
  18. 180  LOCATE 1,CENTER,0:PRINT TITLE$
  19. 190  LOCATE 2,22:COLOR 19:PRINT "(MAXIMUM OF 88 PICTURES PER SESSION)":COLOR 7
  20. 200  LOCATE 5,8,0
  21. 210  PRINT"WHICH DRIVE CONTAINS THE PICTURES: ";
  22. 220  INK$=INKEY$:IF LEN(INK$)<>1 THEN  220
  23. 230  IF INK$=CHR$(27) THEN 1230
  24. 240  PRINT INK$;
  25. 250  IF ASC(INK$)>96 AND ASC(INK$)<103 THEN INK$=CHR$(ASC(INK$)-32)
  26. 260  IF INSTR("ABCDEF",INK$)<1 THEN LOCATE 6,1,0:GOSUB 1120:GOTO 200
  27. 270  DRIVE$=LEFT$(INK$,1)+":"
  28. 280  LOCATE 7,8,0
  29. 290  PRINT "MANUAL OR AUTOMATIC DISPLAY"
  30. 300  LOCATE 8,27,0:PRINT "SELECT M or A : ";
  31. 310  INK$=INKEY$:IF INK$="" THEN 310
  32. 320  IF INK$=CHR$(27) THEN 1230
  33. 330  PRINT INK$;
  34. 340  S=INSTR("MmAa",INK$):IF S<1 THEN LOCATE 9,1,0:GOSUB 1120:GOTO 300
  35. 350  IF S=1 OR S=2 THEN GOTO 790
  36. 360  LOCATE 25,26:BEEP:COLOR 18:PRINT "* Enter    QUIT    To EXIT *";:COLOR 7
  37. 370  LOCATE 10,8,0
  38. 380  PRINT "DISPLAY DURATION IN SECONDS"
  39. 390  LOCATE 11,1,0:PRINT STRING$(79," ");:LOCATE 11,29,0
  40. 400  INPUT "MAXIMUM  60 : ",SECS$
  41. 410  IF SECS$="QUIT" OR SECS$="quit" OR SECS$="Quit" THEN 1230
  42. 420  SECS=VAL(SECS$)
  43. 430  IF SECS>60 THEN LOCATE 11,1,0:GOSUB 1120:GOTO 390
  44. 440  LOCATE 5,8,0
  45. 450  IF S=1 OR S=2 THEN GOTO 790
  46. 460  WIDTH 80:COLOR 0,0,0:CLS
  47. 470  FILES DRIVE$+"*.PIC"
  48. 480  GOSUB 1260
  49. 490  CROW=CSRLIN
  50. 500  COUNT=0
  51. 510  LOCATE 1,1,1
  52. 520  FOR ROW=STL TO CROW
  53. 530  FOR COL=1 TO 72 STEP STP
  54. 540  COUNT=COUNT+1
  55. 550  FOR N=0 TO 11
  56. 560  SORT$(COUNT)=SORT$(COUNT)+CHR$(SCREEN(ROW,(COL+N)))
  57. 570  NEXT N
  58. 580  IF LEFT$(SORT$(COUNT),1)=" " THEN COUNT=COUNT-1 :GOTO 620
  59. 590  SORT$(COUNT)=DRIVE$+SORT$(COUNT)
  60. 600  NEXT COL
  61. 610  NEXT ROW
  62. 620  IF COUNT>88 THEN 1240
  63. 630  TOTPICS=COUNT
  64. 640  FOR COUNT=1 TO TOTPICS-1
  65. 650  FOR PLACE=COUNT+1 TO TOTPICS
  66. 660  IF SORT$(PLACE)<SORT$(COUNT) THEN SWAP SORT$(COUNT),SORT$(PLACE)
  67. 670  NEXT PLACE
  68. 680  NEXT COUNT
  69. 690  SCREEN 1,0:COLOR 0,0
  70. 700  FOR PIC=1 TO TOTPICS
  71. 710  BLOAD SORT$(PIC)
  72. 720  GOSUB 760
  73. 730  CLS
  74. 740  NEXT PIC
  75. 750  GOTO 1230
  76. 760  IF VMODE$="M" THEN GOTO 910
  77. 770  FOR CLOCK!=1 TO 1100*SECS:NEXT
  78. 780  RETURN
  79. 790  CLS:LOCATE 5,22,0:PRINT "Grey Plus Key `+' for next picture."
  80. 800  LOCATE 7,22,0:PRINT "Grey Minus Key `-' for previous picture."
  81. 810  LOCATE 9,22,0:PRINT "F1 thru F8 Change Background Color"
  82. 820  LOCATE 11,22,0:PRINT "F9 and F10 Change Pallette"
  83. 830  LOCATE 13,22,0:PRINT "Esc  Key to EXIT from display"
  84. 840  LOCATE 19,22,0:PRINT "Press   ";CHR$(17);CHR$(196);CHR$(217);"   to begin"
  85. 850  LOCATE 25,26,0:COLOR 18:PRINT "* Press   Esc   To Exit *";:COLOR 7
  86. 860  INK$=INKEY$:IF INK$="" THEN 860
  87. 870  IF INK$=CHR$(27) THEN 1230
  88. 880  IF INK$<>CHR$(13) THEN 860
  89. 890  VMODE$="M"
  90. 900  GOTO 460
  91. 910  INK$=INKEY$:IF INK$="" THEN 910 ELSE IF LEN(INK$)>1 THEN 960
  92. 920  IF INK$="+" THEN RETURN
  93. 930  IF INK$="-" THEN PIC=PIC-2:GOSUB 1100:RETURN
  94. 940  IF INK$=CHR$(27) THEN 1230
  95. 950  GOTO 910
  96. 960  IF LEN(INK$)=2 THEN 970 ELSE 910
  97. 970  S=ASC(MID$(INK$,2,1))-58:IF S<1 OR S>10 THEN 910
  98. 980  ON S GOSUB 1000,1010,1020,1030,1040,1050,1060,1070,1080,1090
  99. 990  GOTO 910
  100. 1000  COLOR 0:RETURN
  101. 1010  COLOR 1:RETURN
  102. 1020  COLOR 2:RETURN
  103. 1030  COLOR 3:RETURN
  104. 1040  COLOR 4:RETURN
  105. 1050  COLOR 5:RETURN
  106. 1060  COLOR 6:RETURN
  107. 1070  COLOR 7:RETURN
  108. 1080  COLOR ,0:RETURN
  109. 1090  COLOR ,1:RETURN
  110. 1100  IF PIC=-1 THEN PIC=0
  111. 1110  RETURN
  112. 1120  BEEP:LOCATE CSRLIN,20,0:PRINT "IMPROPER RESPONSE - PLEASE TRY AGAIN!!";
  113. 1130  FOR COUNT=1 TO 5000:NEXT
  114. 1140  LOCATE CSRLIN,1,0:PRINT STRING$(79," ");
  115. 1150  LOCATE CSRLIN-1,1,0:PRINT STRING$(79," ");
  116. 1160  BEEP:RETURN
  117. 1170  IF ERL<>470 THEN 1200
  118. 1180  COLOR 14,1,0:CLS:LOCATE 12,10,1:PRINT "NO PICTURE FILES FOUND"
  119. 1190  GOSUB 1500:END
  120. 1200  SCREEN 0,1,0,0:WIDTH 80:COLOR 14,1,0:CLS
  121. 1210  LOCATE 12,10,11:PRINT "ERROR";ERR;" OCCURED IN LINE";ERL
  122. 1220  GOSUB 1500:END
  123. 1230  SCREEN 0,1,0,0:WIDTH 80:COLOR 14,1,0:CLS:GOSUB 1500:END
  124. 1240  COLOR 14,1,0:CLS:LOCATE 12,10,1:PRINT "TOO MANY PICTURE FILES!!"
  125. 1250  GOSUB 1500:END
  126. 1260  IF SCREEN(1,14) = 32 THEN 1290
  127. 1270  STP=13
  128. 1280  GOTO 1330
  129. 1290  IF SCREEN(2,14) = 32 THEN 1320
  130. 1300  STP=13
  131. 1310  GOTO 1330
  132. 1320  STP=18
  133. 1330  IF SCREEN(1,9) = 46 THEN STL=1:GOTO 1350
  134. 1340  STL=2
  135. 1350  RETURN
  136. 1360  DEF SEG:POKE 106,0:COLOR 14,1,0:CLS:BEEP
  137. 1370  LOCATE 12,15:PRINT "PROGRAM REQUIRES IBM COMPATABLE COLOR GRAPHICS CARD!"
  138. 1380  BEEP:END
  139. 1390  DEF SEG:P=0
  140. 1400  FOR COUNT=1 TO 10
  141. 1410  KEYHOLD$(COUNT)=""
  142. 1420  WHILE PEEK(P+1619)<>0
  143. 1430  KEYHOLD$(COUNT)=KEYHOLD$(COUNT)+CHR$(PEEK(P+1619))
  144. 1440  P=P+1
  145. 1450  WEND
  146. 1460  P=COUNT*16
  147. 1470  KEYHOLD$(COUNT)=KEYHOLD$(COUNT)+CHR$(0)
  148. 1480  NEXT
  149. 1490  RETURN
  150. 1500  DEF SEG
  151. 1510  FOR COUNT=1 TO 10
  152. 1520  FOR PLACE=1 TO LEN(KEYHOLD$(COUNT))
  153. 1530  POKE 1618+(COUNT-1)*16+PLACE,ASC(MID$(KEYHOLD$(COUNT),PLACE))
  154. 1540  NEXT PLACE,COUNT
  155. 1550  KEY OFF:KEY ON
  156. 1560  RETURN
  157.